(library (lib list-helpers)
  (export list-right-pad
          flatten
          unique-items?
          insertions
          map-append
          permute
          make-list-comparator)

  (import
   (except (rnrs base) let-values map)
   (only (guile)
         lambda* λ)
   (ice-9 match)
   (srfi srfi-1))

  (define list-right-pad
    (λ (lst pad-count pad-value)
      (cond
       [(= pad-count 0) lst]
       [(null? lst)
        (cons pad-value
              (list-right-pad lst
                              (- pad-count 1)
                              pad-value))]
       [else
        (cons (car lst)
              (list-right-pad (cdr lst)
                              (- pad-count 1)
                              pad-value))])))


  ;; This one is a read brain twister.
  (define (flatten lst)
    (let loop ([remaining-lst lst]
               [acc '()])
      (cond
       [(null? remaining-lst) acc]

       ;; If we have a list recur with the head of the list and the
       ;; cdr. Since the acc argument will be consed to the end
       ;; ultimately (see else branch), we can call loop for the head
       ;; of the list and use the result of flattening the tail of the
       ;; list as new acc.

       ;; Since the evaluation order is to evaluate arguments for
       ;; function calls first, we put off the flattening of the head
       ;; of the list until later. The tail of the list will be
       ;; flattened first.

       [(pair? remaining-lst)
        ;; If head is an atom the call will go the the else branch,
        ;; where it will be the `remaining-lst`. It will wait there to
        ;; be consed onto the result for the other call to loop. This
        ;; basically builds up a chain of cons, each waiting for the
        ;; second argument to be computed.

        ;; If head is a list, it will be flattened, which results in
        ;; having the cons chain for that list, which waits for the
        ;; flattened tail to be consed onto that.

        ;; The acc argument is used to thread in the results of
        ;; flattening parts of the list, which will only be seen
        ;; later. It provides a handle onto the later flattened parts
        ;; of the list, to be consed onto those in the else branch. It
        ;; is quite clever actually.

        (loop (car remaining-lst)
              (loop (cdr remaining-lst)
                    acc))]

       ;; If we have an atom, use the atom as is and cons it onto the
       ;; accumulated. The value for acc is computed in the (pair?
       ;; remaining-lst) branch, by another call to loop.

       [else
        (cons remaining-lst acc)])))

  (define unique-items?
    (λ (lst)
      (cond
       [(null? lst) #t]
       [(member (car lst) (cdr lst)) #f]
       [else (unique-items? (cdr lst))])))

  (define insertions
    (λ (elem lst)
      (cond
       [(null? lst) (list (list elem))]
       [else
        (let ([head (car lst)] [tail (cdr lst)])
          (cons
           ;; The matched order of elements. Either insert the
           ;; element as the head ...
           (cons elem lst)
           ;; Cons the head onto all permutations, which
           ;; contain elem.
           (map (λ (permutation) (cons head permutation))
                ;; ... or insert the element anywhere in the
                ;; tail.
                (insertions elem tail))))])))


  (define map-append
    (λ (proc lst)
      (cond
       [(null? lst) '()]
       [else
        (append (proc (car lst))
                (map-append proc (cdr lst)))])))


  (define permute
    ;; Create a lambda, which takes 1 argument and matches it
    ;; against each of the clauses. No need to mention the
    ;; name of the argument.
    (match-lambda
      [() '(())]
      [(head . tail)
       ;; Insert the head at every position in all
       ;; permutations of the tail.
       (map-append (λ (permutation) (insertions head permutation))
                   (permute tail))]))


  (define make-list-comparator
    (λ (elem<)
      (λ (list1 list2)
        (let iter ([as list1] [bs list2])
          (cond
           [(null? as)
            (if (null? bs) #f #t)]
           [(null? bs)
            #f]
           [(elem< (car as) (car bs))
            #t]
           [(elem< (car bs) (car as))
            #f]
           [else
            (iter (cdr as) (cdr bs))]))))))
